home *** CD-ROM | disk | FTP | other *** search
/ The World of Computer Software / The World of Computer Software.iso / miscpas.zip / HAT.PAS < prev    next >
Pascal/Delphi Source File  |  1986-02-05  |  2KB  |  99 lines
  1. PROGRAM hat;
  2.  
  3. {  This program displays on the IBM graphics screen a plot of the 'hat'
  4. {  function.  The hat is displayed in the hi-resolution mode.
  5. {
  6. {  NOTE -- This program will take about an hour to run if you do not have
  7. {  an 8087 chip running with Turbo Pascal-8087 v2.0.  If you do have that
  8. {  hardware/software configuration, the program will run in under three minutes.
  9. {  You cannot halt the program with a BREAK command.  You have to warm boot
  10. {  (CONTROL-ALT-DEL) the IBM.}
  11.  
  12.  
  13. CONST
  14.   p = 310;
  15.   q = 95;
  16.   xp = 180;
  17.   yp = 50;
  18.   zp = 64;
  19.  
  20. VAR
  21.   yf,xy,zf,xf,zt,xt,xr,yr,yy,xpzp : REAL;
  22.   xp2,zi,zzp,zzq,xl,xi,yi         : INTEGER;
  23.   qq, a, zz, xx, x1, y1           : INTEGER;
  24.   aa                              : STRING[100];
  25.  
  26.       TYPE
  27.         varX = RECORD
  28.           varL,varH: BYTE;
  29.         END;
  30.         TimeRec = RECORD
  31.           AX,BX: varX;
  32.           Min,Hour,Msec,Sec: BYTE;
  33.           BP,SI,DI,DS,ES,FLAGS: INTEGER;
  34.         END;
  35.         RecPack = RECORD
  36.           AX: varX;
  37.           BX,CX,DX,BP,SI,DI,DS,ES,FLAGS: INTEGER;
  38.         END;
  39.  
  40.       VAR
  41.         intparm : RecPack;
  42.         i,j : INTEGER;
  43.         rx,ry : INTEGER;
  44.  
  45.  
  46.       PROCEDURE ShowTime;
  47.       VAR
  48.         timeparm : TimeRec;
  49.  
  50.       BEGIN
  51.         WITH TimeParm DO
  52.           BEGIN
  53.             AX.varH := $2C;
  54.             MsDos(timeparm);
  55.             WRITELN('Time is : ',Hour,':',Min,':',Sec,'.',Msec);
  56.           END;
  57.       END;
  58.  
  59.  
  60.  
  61. BEGIN
  62.   qq := 2 * q;
  63.   xr := 1.5*PI;
  64.   xf := xr/xp;
  65.   xpzp := xp/zp;
  66.   xp2 := xp*xp;
  67.   yr := 1;
  68.   yf := yp/yr;
  69.   zf := xr/zp;
  70.  
  71.   ShowTime;
  72.   HIRES; HiresColor(7);
  73.   ShowTime;
  74.   FOR zi:= -q TO q-1 DO
  75.     BEGIN
  76.       IF (zi >= -zp) AND (zi <= zp) THEN
  77.         BEGIN
  78.           zt := zi * xpzp;
  79.           zz := zi;
  80.           xl := TRUNC (0.5 + SQRT(xp2 - zt*zt));
  81.           FOR xi := - xl TO xl DO
  82.             BEGIN
  83.               xt := SQRT(xi*xi + zt*zt) * xf;
  84.               yy := (SIN(xt) + 0.4 * SIN(3 * xt)) * yf;
  85.               x1 := ROUND(xi + zz + p);
  86.               y1 := ROUND(qq - (yy - zz + q));
  87.               PLOT(x1,y1,1);
  88.             END;
  89.         END; {if}
  90.   END; {next zi}
  91.  
  92.   GOTOXY(1,2);
  93.   ShowTime;
  94.   READLN(aa);
  95.   CRTINIT;
  96.   ShowTime;
  97.  
  98. END.
  99.